--- Find frege modules 
module frege.lib.Modules where

import Data.List as L(sortBy)
import Java.util.Zip
import frege.compiler.Classtools as CT(getFrege)
import Data.TreeMap
import Data.Monoid

{--
    Walk a 'ZipFile' and find Frege modules.
    
    The classes inside the ZIP/JAR must be loadable with the given
    'ClassLoader'
    
    Ignores 'ClassNotFoundException's and the strange 'Error's
    that can happen during class loading.
    -}
zipWalk :: MutableIO ClassLoader -> MutableIO ZipFile -> IO [(String, String)]
zipWalk loader zip = do 
          zip.entries           -- read the entries of the zip file
            >>= _.toList        -- make it a list
                                -- remove the directories
            >>= filterM (liftM not . _.isDirectory)
            >>= mapM _.getName  -- give us the names
            >>= mapM (getX loader)       -- load them all 
                . map           -- substitute / and \ with .
                    (_.replaceAll dirSep ".")
                . map           -- cut off ".class"
                    (_.replaceAll classAtEnd "")
                . filter        -- no '$' in the class name
                    (!~ dollars) 
                . filter        -- only "*.class" 
                    (~ classAtEnd)
            >>= pure  . map (fmap _.doc) . catMaybes 
    `finally` zip.close
 
--- load a package and return maybe a tuple of package name and 'FregePackage'
getX loader p = fmap (fmap ((,) p)) (getFrege loader p)
        `catch` classNotFound
        `catch` classForbidden
        `catch` classErrors     -- terrible things can happen on class loading
    where
        classForbidden (ex::SecurityException)     = return Nothing
        classNotFound (ex::ClassNotFoundException) = return Nothing
        classErrors   (ex::Error)                  = return Nothing
        
        
classAtEnd = ´\.class$´
dollars    = ´\$´
dirSep    = ´/|\\´ 

--- the path separator used here
pathSep = fromMaybe ":"  (System.getProperty "path.separator")

--- a pattern that can be used to 'Regex.split' a 'String' by the path separator
pathRE = case regcomp pathSep.quote of
    Right p -> p
    Left _ -> Prelude.error ("cannot regcomp " ++ pathSep.quote)

--- the class path this JVM started with, as ['String']
classPath = (pathRE.splitted • fromMaybe "." • System.getProperty) "java.class.path"


{--
    Walk a directory and find Frege modules.
    
    The classes in the directory must be loadable with the given
    'ClassLoader'
    
    Ignores 'ClassNotFoundException's and the strange 'Error's
    that can happen during class loading.  
    -}
dirWalk :: MutableIO ClassLoader -> String -> File -> IO [(String, String)]
dirWalk loader sofar file = do
    isd  <- file.isDirectory
    isf  <- file.isFile
    let name = file.getName
        subof "" x = x
        subof a  x = a ++ "." ++ x
    if isf 
    then do
        if name ~ classAtEnd && name !~ dollars
        then do
            let pack = sofar.replaceAll classAtEnd ""
            fmap (maybeToList . fmap (fmap _.doc)) (getX loader pack)
        else 
            return []
    else if name !~ dollars
        then do
            subfiles <- file.list
            case subfiles of
                Nothing    -> return []
                Just files -> do
                    ls <- readonly toList files
                    let subwalk f = dirWalk loader (subof sofar f) $ File.new file f
                    mapM subwalk ls >>= return . concat 
        else return []

--- Walk a directory or a zip file and search for Frege packages.
--- If the argument is neither a directory nor a ZIP/JAR file, an empty list is returned.
walkThing arg = do
        loader  <- CT.makeClassLoader [arg]
        let what = File.new arg
        isdir   <- what.isDirectory
        if isdir 
            then dirWalk loader "" what
            else ZipFile.new what >>= zipWalk loader
            -- `catch` cnf
                    `catch` fnf
    where
        -- cnf (ex::ClassNotFoundException) = return []
        fnf (ex::FileNotFoundException) =  do
            stderr.println ("Could not walk " ++ ex.getMessage)
            pure []

--- walk the class path
walkCP   = concat <$> mapM walkThing classPath

--- walk a given path
walkPath = fmap concat . mapM walkThing . pathRE.splitted
                        
main args = do
    all <- walkCP
    mapM_ (println . fst) all
    let t = fold pack (Y$T$mempty) (map sp all)
        sp (a,b) = (Regex.splitted ´\.´ a, b)
    print "top level:"
    println (map fst (flat t))
    case pfind args t of
        Just (Y (T t)) -> println (keys t)
        Just (Y (R s)) -> println s
        Nothing -> stderr.println "Not found"      

data RTree a = !T (TreeMap String a) | !R String

instance Functor RTree where
    fmap f (T t) = T $ fmap f t
    fmap f (R r) = R r 

data Y f = !Y (f (Y f))

noPacks = Y (T mempty)

out ∷ Y α → α (Y α)
out (Y x) = x

pack :: Y RTree -> ([String], String) -> Y RTree
pack p ([s], doc) = case out p of
    T x -> (Y . T . x.insert s) $! (Y (R doc))
    R _ -> p    -- this is bad, should be a directory, but is module

pack p ((s:ss), fp) = case out p of
    T x -> case x.lookup s of
        Just p' -> (Y . T . x.insert s) $! (pack p' (ss, fp))
        Nothing -> (Y . T . x.insert s) $! (pack noPacks (ss, fp)) 
    R _ -> p    -- this is bad, should be a directory, but is module

pack p ([], _)  = p 

pfind [] p  = Just p
pfind (s:ss) p = case out p of
    T x -> x.lookup s >>= pfind ss
    R _ -> Nothing
    
      
flat p = case out p of
    T x -> sortBy (comparing fst) (each x)
    R _ -> []

nf p = case out p of
    T x -> case fmap nf x of !y -> Y (T y)
    R s -> Y (R s) 


unR y = case out y of
    R x -> Just x
    _   -> Nothing  